home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / ctlib100.zip / INSTALL.LZH / BITREES2.PAS < prev    next >
Pascal/Delphi Source File  |  1996-10-12  |  4KB  |  145 lines
  1. {**************************************************************************}
  2. {*  BitSoft Development, L.L.C.                                           *}
  3. {*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
  4. {*  All rights reserved.                                                  *}
  5. {*  Containers Library demo                                               *}
  6. {**************************************************************************}
  7.  
  8. program BiTrees2;
  9.  
  10. {$X+}
  11.  
  12. { Sample program for using an AVL tree. }
  13.  
  14. uses Objects, Containr, ctBiTree,
  15.      {$ifdef Windows}
  16.      WinCtr;
  17.      {$else}
  18.      Crt;
  19.      {$endif}
  20.  
  21. type
  22.   PContact = ^TContact;
  23.   TContact = object (TAVLNode)
  24.       FirstName,
  25.       LastName,
  26.       Phone,
  27.       Company : PString;
  28.     constructor Init(ALastName, AFirstName, APhone, ACompany : string);
  29.     function KeyOf : Pointer; virtual;
  30.     destructor Done; virtual;
  31.   end; { TContact }
  32.  
  33. constructor TContact.Init(ALastName, AFirstName, APhone, ACompany : string);
  34. begin
  35.   TBinaryNode.Init;
  36.   FirstName := NewStr(AFirstName);
  37.   LastName := NewStr(ALastName);
  38.   Phone := NewStr(APhone);
  39.   Company := NewStr(ACompany);
  40. end;
  41.  
  42. destructor TContact.Done;
  43. begin
  44.   DisposeStr(FirstName);
  45.   DisposeStr(LastName);
  46.   DisposeStr(Phone);
  47.   DisposeStr(Company);
  48.   TBinaryNode.Done;
  49. end;
  50.  
  51. function TContact.KeyOf : Pointer;
  52. begin
  53.   KeyOf := LastName;
  54. end;
  55.  
  56. procedure DisplayContacts(ContactList : PGraph);
  57.  
  58.   procedure PrintInfo (Item : Pointer); far;
  59.   begin
  60.     with PContact(Item)^ do
  61.       writeln(LastName^, '':15 - Length(LastName^),
  62.         FirstName^, '':15 - Length(FirstName^),
  63.         Phone^, '':20 - Length(Phone^),
  64.         Company^, '':20 - Length(Company^));
  65.   end;
  66.  
  67. begin
  68.   ContactList^.ForEach(@PrintInfo);
  69. end;
  70.  
  71. procedure DisplayFirst(ContactList : PGraph);
  72. var
  73.   Item : Pointer;
  74. begin
  75.   Item := ContactList^.First;
  76.   Writeln('First item:');
  77.   with PContact(Item)^ do
  78.     writeln(LastName^, '':15 - Length(LastName^),
  79.       FirstName^, '':15 - Length(FirstName^),
  80.       Phone^, '':20 - Length(Phone^),
  81.       Company^, '':20 - Length(Company^));
  82.   ContactList^.DoneItem(Item); { not required }
  83. end;
  84.  
  85. procedure DisplayLast(ContactList : PGraph);
  86. var
  87.   Item : Pointer;
  88. begin
  89.   Item := ContactList^.Last;
  90.   Writeln('Last item:');
  91.   with PContact(Item)^ do
  92.     writeln(LastName^, '':15 - Length(LastName^),
  93.       FirstName^, '':15 - Length(FirstName^),
  94.       Phone^, '':20 - Length(Phone^),
  95.       Company^, '':20 - Length(Company^));
  96.   ContactList^.DoneItem(Item); { not required }
  97. end;
  98.  
  99. procedure FindLastName(ContactList : PGraph; LastName : string);
  100. var
  101.   Item : Pointer;
  102. begin
  103.   Item := ContactList^.KeyFirst(@LastName);
  104.   Writeln('Item found with last name ''', LastName, ''':');
  105.   with PContact(Item)^ do
  106.     writeln(LastName^, '':15 - Length(LastName^),
  107.       FirstName^, '':15 - Length(FirstName^),
  108.       Phone^, '':20 - Length(Phone^),
  109.       Company^, '':20 - Length(Company^));
  110.   ContactList^.DoneItem(Item); { not required }
  111. end;
  112.  
  113. var
  114.   ContactInfo : PAVLTree;
  115.  
  116. begin
  117.   ClrScr;
  118.  
  119.   { Create the collection }
  120.   ContactInfo := New(PAVLTree, Init);
  121.  
  122.   { Insert items into the collection }
  123.   with ContactInfo^ do
  124.   begin
  125.     Insert(New(PContact, Init('Lewis', 'Carl', '(506) 83-780',
  126.       'Running, Corp.')));
  127.     Insert(New(PContact, Init('Benton', 'Michael', '(403) 33-973',
  128.       'ER, Inc.')));
  129.     Insert(New(PContact, Init('Wagner', 'Robert', '(906) 11-230',
  130.       'Symphony, Ltd.')));
  131.     Insert(New(PContact, Init('Smith', 'John', '(656) 75-843',
  132.       'InterComm, Corp.')));
  133.   end; { with }
  134.  
  135.   DisplayContacts(ContactInfo);
  136.   Writeln;
  137.   DisplayFirst(ContactInfo);
  138.   Writeln;
  139.   DisplayLast(ContactInfo);
  140.   Writeln;
  141.   FindLastName(ContactInfo, 'Wagner');
  142.  
  143.   { Dispose of the collection and all the objects in it }
  144.   Dispose(ContactInfo, Done);
  145. end.